COMMENT ⊗   VALID 00012 PAGES VERSION 16-2(4)
RECORD PAGE   DESCRIPTION
 00001 00001
 00002 00002	HISTORY
 00003 00003	DSCR REMEMB,FORGET,RESTOR 
 00013 00004	COPSTR:					COPY STRING
 00018 00005	DSCR FORGET 
 00023 00006	DSCR RESTOR RESTORE CONTENTS OF VARIABLES 
 00026 00007	RESFND:					FOUND MATCH
 00028 00008	
 00029 00009	DSCR  ALLRM,ALLFOR,ALLRS. 
 00031 00010	DSCR GFREES 
 00039 00011	DSCR .INCONT- IS VAR IN CONTEXT
 00042 00012	BEND	LEAP
 00043 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  202000000004  ⊗;


COMMENT ⊗
VERSION 16-2(4) 2-13-73 
VERSION 16-2(3) 2-13-73 BY JRL ADD INCONT ROUTINE
VERSION 16-2(2) 2-13-73 
VERSION 16-2(1) 9-21-72 BY JRL PUT IN VERSION NUMBER

⊗;
DSCR REMEMB,FORGET,RESTOR 
⊗


	DESC ←← 400000			;INDICATES A DESCRIPTOR OF SOME SORT
	ISARR ←← 200000			;ARRAY
	ISSTR ←← 100000			;STRING
	ISSET ←←  40000			;SET OR LIST


HERE(REMEMB)
	PUSHJ	P,STACSV		;SAVE OFF ACCUMULATORS
	MOVE	TABL,GOGTAB		;USER TABLE
	POP	P,LPSA			;RETURN ADDRESS
	POP	P,D			;REF TO CONTEXT
	SKIPN	FP,FP2(TABL)		;ANY TWO WORD FREES YET
	PUSHJ	P,FP2DON		;NO GO GET SOME
	MOVEM	FP,FP2(TABL)
LPREM:
	POP	P,A			;VAR TO BE SAVED
	JUMPE	A,RETALL		;IF THROUGH, RETURN
	TLNE	A,ISARR			;IF ARRAY GET DESCRIPTOR
	HRR	A,(A)
	TRNN	A,-1			;IF NOTHING THERE, TROUBLE
	ERR	<REMEMBER: MISSING ARRAY DESCRIPTOR>,1
	MOVEI	B,(D)			;START LOOKING AT HEAD OF CONTEXT LIST
	HRRZ	C,(B)			
	JUMPE	C,INSERT		;NIL CONTEXT LIST?
LPREM2:
	HLRZ	PNT,(C)			;CANDIDATE
	CAIN	PNT,(A)			;SAME AS OUR PARM.
	JRST	REMREP			;YES.
	CAIL	PNT,(A)			;FURTHER DOWN LIST?
	JRST	INSERT			;NO.
;AT THIS POINT WE HAVE DETERMINED THAT THE ADDRESS OF THE PARAMETER
;IS GREATER THAT THE ADDRESS OF THE  STORED VALUE, BUT THE PARAMETER
;MAY STILL BE AN ELEMENT OF A STORED ARRAY
	MOVE	TEMP,(C)		;DESC BIT ON IF MIGHT BE ARRAY
	TLNN	A,ISARR			;IS PARAM AN ARRAY
	TRNN	TEMP,DESC		;STORED	ONE A DESCRIPTOR	
	JRST 	REMCDR			;NOT ELEM OF STORED ARRAY.
	MOVE	TEMP,1(C)		;GET DESCRIPTOR
	TLNN	TEMP,ISARR		;STORED ARRAY?
	JRST	REMCDR			;NO.
	HRRZ	FPD,-1(TEMP)		;SIZE OF ARRAY.
	SKIPG	-2(TEMP)		;STRING ARRAY?
	HRRZ	FPD,-2(TEMP)		;GET SIZE OF STRING ARRAY
	ADDI	FPD,(TEMP)		;ADDR LAST +1 ELEM OF ARRAY
	CAIG	FPD,(A)			;MUST BE GREATER THAT PARAM ADDR
	JRST	REMCDR			;ISN'T
;WE'RE REMEMBERING A SINGLE ELEMENT OF AN ALREADY SAVED ARRAY
	MOVEI	TEMP,(A)		;ADDR ARRAY ELEM TO BE SAVED
	SUBI	TEMP,(PNT)		;OFFSET OF ARRAY ELEM
	ADD	TEMP,1(C)		;ADDR SAVED ARRAY
	TLNN	A,ISSET			;SAVING A SET?
	JRST	ELNSET			;NO.
	SKIPN	FPD,(TEMP)		;ADDR LASTWORD,,FIRSTWORD
	JRST	RNOSET			;SET WAS NULL.
	HLRZ	PNT,(FPD)		;LASTWORD ADDR
	HRR	FP,FP1(TABL)		;HEAD OF ONE-WORD FREES
	HRRM	FP,(PNT)		;LINK IN RELEASED SET
	HRRM	FPD,FP1(TABL)		;NEW FREE-LIST
RNOSET:	
	SAVACS	<(TEMP,LPSA,D)>
	PUSH	P,A			;SET TO BE COPIED
	PUSH	P,[0]			;NULL SET
GLOB<
	TLZ	FLAG,GLBSRC		;TURN OFF GLBSRC BIT
>;GLOB
	PUSHJ	P,CATLST		;LET CAT DO THE WORK
	HLRE	FLAG,(P)		;GET NEG LENGTH
	MOVMS	FLAG			;MAKE POS
	HRLM	FLAG,(P)		;STORE INTO SET DESCRIPTOR
	POP	P,FLAG			;SET DESCRIPTOR
	RESTACS <(D,LPSA,TEMP)>
	MOVEM	FLAG,(TEMP)		;SAVE SET
	JRST	LPREM			;GET NEXT PARAM IF ANY
ELNSET:
	TLNN	A,ISSTR			;SAVING A STRING?
	JRST	REMESY			;NO.
	HRROS	A			;PREPARE FOR POP'S
	POP	A,(TEMP)		;2ND WORD STRING DESCRIPTOR
	POP	A,-1(TEMP)		;1ST WORD
	JRST	LPREM			;NEXT PARAM
REMESY:
	MOVE	FLAG,(A)
	MOVEM	FLAG,(TEMP)
	JRST	LPREM			;NEXT PARAM

REMCDR:
	MOVEI	B,(C)			;CDR CONTEXT LIST.
	HRRZ	C,(C)
	TRZ	C,DESC			;TURN OFF DESCRIPTOR BIT
	JUMPN	C,LPREM2		;LOOP IF NOT AT END OF LIST
INSERT:
	MOVE	FP,FP2(TABL)		;TWO WORD FREE
	MOVEI	PNT,(FP)		;SAVE ADDR.
	SKIPN	FP,(FP)			;FOR NEXT TIME
	PUSHJ	P,FP2DON		;GET SOME MORE.
	MOVEM	FP,FP2(TABL)		;SAVE CDR FREE LIST
	HRRM	C,(PNT)			;CDR CONTEXT
	DPB	PNT,[POINT 17,(B),35]	;DON'T TOUCH PREVIOUS DESCP BIT
	HRLM	A,(PNT)			;THE REFERENCE
	TLNN	A,ISARR!ISSET!ISSTR	;A DESCRIPTOR TYPE OF THING?
	JRST	SCALAR			;NO.
	MOVEI	FLAG,DESC		;DESCRIPTOR BIT
	ORM	FLAG,(PNT)		;MARK AS DESCRIPTOR
	TLNN	A,ISARR			;AN ARRAY?
	JRST	NTARRY			;NO.
	MOVEI	B,(PNT)
;MAY WANT TO DELETE APPROPRIATE ARRAY ELEMENTS HERE
	JUMPE	C,REMVN2		;IF NULL CDR 
	HRRZ	FPD,-1(A)		;LENGTH OF ARRAY
	SKIPG	-2(A)			;STRING ARRAY?
	HRRZ	FPD,-2(A)		;LENGTH OF STRING ARRAY
	ADDI	FPD,(A)			;ADDR 1 PAST END OF ARRAY
	PUSH	P,A			;SAVE AC
	PUSH	P,FPD			;
LPREMV:
	HLRZ	FLAG,(C)			;CAND.
	CAML	FLAG,(P)			;WITHIN ARRAY?
	JRST	REMVND			;NO.
	PUSHJ	P,RELNOD		;RELEASE NODE
	LDB	C,[POINT =17,(B),=35]
	JUMPN	C,LPREMV
REMVND:
	SUB	P,X11			;REMOVE HIGH ADDR OF ARRAY
	POP	P,A
REMVN2:
	MOVE	FLAG,A			;SAVE TYPE BITS LEFT HALF.
	PUSH	P,A			;PARAM TO ARCOP
	PUSHJ	P,ARCOP			;COPY THE ARRAY.
	MOVE	TABL,GOGTAB		;DON'T TRUST ARRAY ROUTINES
	HRR	FLAG,A			;READY TO SAVE ADDR.
	MOVEM	FLAG,1(B)		;SAVE ARRAY DESCRIPTOR
	TLNN	FLAG,ISSTR		;STRING ARRAY?
	JRST	NTSTR			;NO.
	SKIPN	FP,FP1(TABL)		;GET ONE WORD FREES.
	PUSHJ	P,FP1DON
	MOVEI	C,(FP)			;SAVE ADDR ONE WORD FREE
	SKIPN	FP,(FP)			;FOR NEXT TIME.
	PUSHJ	P,FP1DON		;IF OUT, GET MORE.
	HRRM	FP,FP1(TABL)		;SAVE CDR ONE-WORD FREE LIST
	MOVE	A,ARYLS(TABL)		;OLD STRING ARRAY LIST
	HRRM	A,(C)			;ADD NEW ELEMENT
	HRLM	FLAG,(C)		;ADDRESS STRING ARRAY
	MOVEM	C,ARYLS(TABL)		;SAVE STRING ARRAY LIST
	JRST 	LPREM			;CONTINUE
NTSTR:	
	TLNN	FLAG,ISSET		;SET ARRAY?
	JRST	LPREM			;NO.
	SAVACS	<(D,LPSA)>
	SKIPN	FP,FP1(TABL)		;ONE WORD FREES INITED?
	PUSHJ	P,FP1DON		;NO, GO DO IT.
	HRRM	FP,FP1(TABL)
	PUSHJ	P,COPARR		;COPY THE LIST ARRAY (ADDR IN A)
	RESTACS <(LPSA,D)>		;RESTORE SAVED AC'S
	JRST	LPREM			;CONTINUE
NTARRY:					;NOT AN ARRAY
	TLNE	A,ISSTR			;A STRING?
	JRST	COPSTR			;MUST COPY STRING
	TLNN	A,ISSET			;HAD BETTER BE SET
	ERR	<DRYROT REMEMBER 2>
	SAVACS	<(LPSA,D,PNT)>		;SAVE AC'S WHICH WILL CHANGE
	PUSH	P,(A)			;SET TO BE COPIED
	PUSH	P,[0]			;NULL SET.
GLOB <
	TLZ	FLAG,GLBSRC		;TURN OFF GLBSRC BIT
>;GLOB
	PUSHJ	P,CATLST		;COPY SET
	HLRE	FLAG,(P)		;COUNT OF SET
	MOVMS	FLAG			;MAKE POS.
	TRO	FLAG,ISSET		;MARK AS SET DESCRIPTOR
	HRLM	FLAG,(P)		;
	POP	P,FLAG
	RESTACS <(PNT,D,LPSA)>		;RESTORE AC'S
	JRST	COMMN
COPSTR:					;COPY STRING
	PUSHJ	P,SDESCR		;GET A STRING DESCRIPTOR
	POP	P,A			;NEW DESCRIPTOR
	HLRO	TEMP,(PNT)		;STRING TO BE COPIED
	POP	TEMP,(A)		;SECOND WORD
	POP	TEMP,-1(A)		;FIRST WORD
	HRRZ	FLAG,A
	TLO	FLAG,ISSTR		;MARK AS STRING DESCRIPTOR
	JRST	COMMN
SCALAR:					;SIMPLE SCALAR
	MOVE	FLAG,(A)		;VALUE
COMMN:				
	MOVEM	FLAG,1(PNT)		;SAVE VALUE
	JRST	LPREM


REMREP:	PUSH	P,[LPREM]		;IN-LINE CALL
REP1:					

COMMENT ⊗ REPLACE THE OLD SAVED VALUE WITH THE CURRENT VALUE.
	C - ADDR CONTEXT NODE
	CALLED WITH PUSHJ ⊗
;HERE MAY HAVE TO INSERT SPECIAL STUFF FOR HANDLING FIRST ELEM OF ARRAY
	MOVE	PNT,(C)			;FIND OUT IF DESCRIPTOR
	HLRZ	A,(C)			;ADDRESS OF SAVED VAR.
	TRNE	PNT,DESC		;A DESCRIPTOR?
	JRST	ISDESC			;YES.
	MOVE	FLAG,(A)		;VALUE
	MOVEM	FLAG,1(C)		;SAVE IT.
	POPJ	P, 			;RETURN
ISDESC:
	MOVE	PNT,1(C)		;GET DESCRIPTOR
	TLNE	PNT,ISARR		;AN ARRAY?
	JRST	REPARR			;YES.
	TLNE	PNT,ISSTR		;SCALAR STRING?
	JRST	REPSTR			;YES.
	TLNN	PNT,ISSET		;HAD BETTER BE SET.
	ERR	<DRYROT - REMEMBER 1>
	TRNN	PNT,-1			;SEE IF NULL SET
	JRST	SETREL			;YES, DON'T TRY TO RELEASE
	MOVE	FP,FP1(TABL)		;PREPARE TO RELEASE SET
	HLRZ	PNT,(PNT)		;ADDR END OF SET
	HRRM	FP,(PNT)		;LINK SET ONTO FREE-LIST
	MOVE	PNT,1(C)		;GET SET HEAD
	HRRM	PNT,FP1(TABL)		;SAVE FREE-LIST
SETREL:
	SAVACS	<(LPSA,D,C)>		;SAVE IMPORTANT AC'S
	PUSH	P,(A)			;SET TO BE COPIED
	PUSH	P,[0]			;NULL SET
GLOB<
	TLZ	FLAG,GLBSRC		;TURN OFF GLBSRC BIT
>;GLOB
	PUSHJ	P,CATLST		;LET CATLST COPY SET
	POP	P,TEMP
	RESTACS <(C,D,LPSA)>		;RESTORE AC'S
	HLRE	FLAG,TEMP		;LENGTH OF SET
	MOVMS	FLAG			;MAKE POSITIVE
	TRO	FLAG,ISSET		;IS A SET DESCRIPTOR
	HRLM	FLAG,TEMP
	MOVEM	TEMP,1(C)		;SAVED SET
REPCOM:	
	POPJ	P,			;RETURN TO WHOEVER.

REPSTR:	
	HRROI	TEMP,(A)		;ADDR OF NEW STRING
	POP	TEMP,(PNT)		;SECOND WORD
	POP	TEMP,-1(PNT)		;FIRST WORD
	POPJ	P,

REPARR:					;REPLACE AN ARRAY
	TLNN	PNT,ISSET			;A SET ARRAY?
	JRST	REPESY			;NO, JUST AS EASY TYPE
	PUSH	P,PNT			;ADDRESS OF SAVED ARRAY
	PUSHJ	P,ARRRCL		;RECLAIM LIST SPACE
REPESY:					;BLT IN NEW CONTENTS
	TLNE	PNT,ISSTR		;A STRING ARRAY
	JRST	[SUBI	PNT,1		;STRING ARRAY
		 SUBI	A,1		;ALSO NEW ARRAY
		 JRST .+1]
	HRRZ	FLAG,-1(PNT)		;SIZE OF ARRAY
	ADDI	FLAG,-1(PNT)		;LAST WORD TO BE SAVED
	HRLI	A,(PNT)			;ADDR FIRST WORD IN COPY OF ARRAY
	MOVSS	A			;PREPARE FOR BLT
	BLT	A,(FLAG)		;BLT ARRAY
	TLNN	PNT,ISSET		;SET ARRAY?
	POPJ	P,			;NO,RETURN.
	SAVACS <(C,D,LPSA)>
	PUSHJ	P,COPARR		;COPY THE ELEMENTS ADDR ARRAY IN A
	RESTACS <(LPSA,D,C)>
	POPJ	P,			;RETURN
RETALL: PUSH	P,LPSA			;THE RETURN ADDRESS
	JRST	STACRS			;RESTORE AC'S

DSCR FORGET ⊗

HERE(FORGET)				;FORGET NAMED VARIABLES
	PUSHJ	P,STACSV		;SAVE OFF AC'S
	MOVE	TABL,GOGTAB		;USER TABLE
	POP	P,LPSA			;RETURN ADDRESS
	POP	P,D			;CONTEXT ADDRESS
LPFORG:	POP	P,A			;THE VARIABLE'S ADDRESS
	JUMPE	A,RETALL		;IF NONE, RETURN
	TLNE	A,ISARR			;IF ARRAY GET DESCRIPTOR
	HRR	A,(A)
	TLNN	A,-1
	ERR	<DRYROT AT FORGET- NO DESCRIPTOR>,1
	SKIPN	C,(D)			;HEAD OF CONTEXT LIST
NTTHER:	ERR <FORGETTING UNREMBERED VARIABLE>,1,LPFORG
	MOVEI	B,(D)			;BACK POINTER
LPFOR2:
	HLRZ	PNT,(C)			;CANDIDATE
	CAIN	PNT,(A)			;RIGHT ONE?
	JRST 	FNDNOD			;THE SAME.
	CAIL	PNT,(A)			;FURTHER DOWN LIST?
	JRST 	NTTHER			;NO, SIGNAL ERROR
	MOVEI	B,(C)			;CDR LIST
	HRRZ	C,(C)
	TRZ	C,DESC
	JUMPN	C,LPFOR2		;LOOP
	JRST 	NTTHER			;WASN'T IN CONTEXT
FNDNOD:					;FOUND IN CONTEXT TO RELEASE
	PUSH	P,[LPFORG]		;IN LINE CALL
RELNOD:					;TO GENERALLY RELEASE NODE
					;B CONTAINS BACKPOINTER,C THIS NODES ADDR.
	MOVE	PNT,(C)			;FIRST UNLINK NODE
	DPB	PNT,[POINT 17,(B),35]
	TRNN	PNT,DESC		;HARD CASE?
	JRST	FORESY			;NO
	MOVE	PNT,1(C)		;GET DESCRIPTOR
	TLNE	PNT,ISARR		;ANY KIND OF ARRAY?
	JRST	FORARR			;YES
	TLNE	PNT,ISSTR		;A SCALAR STRING?
	JRST	FORSTR			;YES
	TLNN	PNT,ISSET		;SHOULD BE THIS TYPE
	ERR	<DRYROT - FORGET 1>
	TRNN	PNT,-1			;NULL SET
	JRST	FORESY			;YES
	HLRZ	FLAG,(PNT)
	MOVE	FP,FP1(TABL)		;OLD FREE-LIST
	HRRM	FP,(FLAG)		;LINK ONTO RELEASED SET
	HRRM	PNT,FP1(TABL)		;SET RECLAIMED
	JRST 	FORESY			;NOTHING TO IT.
FORSTR:
	SETZM	-1(PNT)			;MAKE INTO NULL STRING
	HLRZ	FLAG,HASHP(TABL)	;STRING DESCRIPTOR LIST
	HRRM	FLAG,(PNT)		;LINK DESCRIPTOR ONTO FREE LIST
	HRLM	PNT,HASHP(TABL)		;ALL DONE
	JRST	FORESY
FORARR:					;AN ARRAY
	TLNN	PNT,ISSET!ISSTR		;SIMPLE ARRAY?
	JRST	FARESY			;YUPP!
	TLNN	PNT,ISSTR		;SET ARRAY
	JRST	FSTARY			;YES.
	SETZM
;STRING ARRAY MUST BE REMOVED FROM ARYLS LIST
	MOVEI	TEMP,ARYLS(TABL)	;BACK POINTER
	JRST	ENDSRY			;JUMP TO TEST
LPSARY:	HLRZ	FLAG,(FPD)		;CANDIDATE
	CAIN	FLAG,(PNT)		;GOT IT?
	JRST	FNDARY			;YES
	MOVEI	TEMP,(FPD)		;FOR NEXT TIME
ENDSRY:	SKIPE	FPD,(TEMP)		;GET NEXT CANDIDATE.
	JRST 	LPSARY			;LOOP
	ERR	<DRYROT FORGET 2>
FNDARY:
	HRRZ	FLAG,(FPD)		;LINK TO NEXT IN ARYLS
	HRRM	FLAG,(TEMP)		;DELETE NODE FROM LIST
	HRR	FP,FP1(TABL)		;PREPARE TO RELEASE FREE
	HRRM	FP,(FPD)
	HRRM	FPD,FP1(TABL)		;DONE
	JRST 	FARESY
FSTARY:
	PUSH	P,(PNT)			;ARRAY ADDRESS
	PUSHJ	P,ARRRCL		;RECLAIM LIST SPACE
FARESY:
	SAVACS	<(B,C,D,LPSA)>
	PUSH	P,PNT			;ARRAY TO BE RELEASED
	PUSHJ	P,ARYEL			;RELEASE IT
	RESTACS <(LPSA,D,C,B)>
	MOVE	TABL,GOGTAB
FORESY:
	MOVE	FP,FP2(TABL)		;PREPARE TO RELEASE TWO WORD FREE
	MOVEM	FP,(C)
	HRRM	C,FP2(TABL)
	POPJ	P,			;RETURN TO WHOEVER
DSCR RESTOR RESTORE CONTENTS OF VARIABLES ⊗
HERE(RESTOR)					;ENTRY 
	PUSHJ	P,STACSV
	MOVE 	TABL,GOGTAB		;SET UP USER TABLE REG.
	POP	P,LPSA			;RETURN ADDR
	POP	P,D			;CONTEXT ADDR
LPRES:	
	POP	P,A			;ADDR VAR TO BE RESTORED
	JUMPE	A,RETALL		;RETURN WHEN THROUGH
	TLNE	A,ISARR
	HRR	A,(A)
	TRNN	A,-1
	ERR	<DRYROT AT RESTOR>
	HRRZ	C,(D)			;ADDR FIRST NODE IN LIST
LPRES2:
	JUMPE	C,RESERR		;ERROR IF NIL LIST.
	HLRZ	PNT,(C)			;REFERENCE
	CAIN	PNT,(A)			;THE SAME?
	JRST	RESFND			;YES.
	HRRZ	FLAG,(C)		;DESC BIT&LINK
	TRZN	FLAG,DESC		;TURN OFF DESC,IF DESC STILL POSSIBILITY
	JRST	RESCDR
	MOVE	B,1(C)			;THE DESCRIPTOR
	TLNN	B,ISARR			;AN ARRAY?
	JRST	RESCDR			;NO.
	MOVE	FP,PNT			;ADDR ARRAY
	TLNE	B,ISSTR			;STRING ARRAY?
	SUBI	FP,1			;SUB 1 FOR STRING ARRAY
	HRRZ	FP,-1(FP)		;LENGTH OF ARRAY
	ADDI	FP,(PNT)		;ADDR LAST ELEM IN ARRAY
	CAIL	FP,(A)			;IS VAR IN THIS ARRAY
	CAILE	PNT,(A)			;
	JRST	RESCDR			;NO
	HRROI	TEMP,(A)		;ADDR OF ELEM TO BE RESTORED
	SUBI	TEMP,(PNT)		;OFFSET
	ADDI	TEMP,(B)		;ADDR IN SAVED ARRAY.
	TLNN	B,ISSET!ISSTR		;HARD TYPE?
	JRST	RESES1			;NO.
	TLNN	B,ISSET			;A SET
	JRST	ISSTR			;NO A STRING
	SAVACS  <(LPSA,D,A)>		;SAVE IMPORTANT AC'S
	PUSH	P,(TEMP)		;SET TO BE COPIED
	PUSH 	P,[0]			;NIL SET
	PUSHJ	P,CATLST		;LET CAT DO THE WORK
	RESTACS	<(A,D,LPSA)>		;RESTORE AC'S
	HLRE	FLAG,(P)		;COUNT
	MOVMS	FLAG			;MAKE POSITIVE FOR PERM. SET.
	HRLM	FLAG,(P)		;PUT IT BACK
	POP	P,(A)			;SAVE THE SET
	JRST	LPRES			;NEXT ONE
RESCDR:
	MOVEI	B,(C)
	HRRZ	C,(C)
	TRZ	C,DESC
	JRST	LPRES2
RESERR:
	ERR	<RESTORE UNREMEMBERED VARIABLE>,1
	JRST	LPRES2
RE1STR:					;A STRING WITHIN A STRING ARRAY
	POP	TEMP,(A)
	POP	TEMP,-1(A)
	JRST	LPRES
RESES1:
	MOVE	FLAG,(TEMP)
	MOVEM	FLAG,(A)
	JRST 	LPRES
RESFND:					;FOUND MATCH
	PUSH	P,[LPRES]		;IN-LINE CALL
RESNOD:					;RESTORE NODE ADDR IN C.
	MOVE	TEMP,(C)		;GET ENTIRE FIRST WORD.
	HLRZ	PNT,TEMP		;PLACE TO BE RESTORED TO.
	MOVE	FLAG,1(C)		;THE DESCRIPTOR, OR VALUE.
	TRNN	TEMP,DESC		;A DESCRIPTOR?
	JRST	RESESY			;NO.
	TLZE	FLAG,ISARR		;AN ARRAY?
	JRST	RESAR2			;YES.
	TLZN	FLAG,ISSET		;A SET?
	JRST	RESSTR			;NO, A STRING.
	SKIPN	TEMP,(PNT)		;IS SET TO BE REPLACED NULL
	JRST	RESST2			;YES
	HLRZ	B,(PNT)			;LAST NODE IN SET
	MOVE	FP,FP1(TABL)		;END OF FREE-LIST
	HRRM	FP,(B)			;CAT ONTO RELEASED SET
	HRRM	PNT,FP1(TABL)		;SAVE NEW FREE-LIST
RESST2:
	SAVACS	<(LPSA,D,C)>
	PUSH	P,FLAG
	PUSH	P,[0]
GLOB <
	MOVEI	FLAG,0			;MAKE SURE GLB BIT OFF
>;GLOB
	PUSHJ	P,CATLST		;LET CAT DO THE WORK
	HLRE	FLAG,(P)		;RESULTANT SET
	MOVMS	FLAG			;MAKE INTO PERM SET.
	HRLM	FLAG,(P)
	POP	P,FLAG			;GET THE SET BACK
	RESTACS	<(C,D,LPSA)>
	HLRZ	PNT,(C)
	MOVEM	FLAG,(PNT)		;SAVE THE NEW SET.
	POPJ	P,			;RETURN
RESSTR:					;RESTORE A SCALAR STRING
	HRROI	FLAG,(FLAG)		;PREPARE FOR POP'S
	POP	FLAG,(PNT)		;SECOND WORD
	POP	FLAG,-1(PNT)		;FIRST WORD
	POPJ	P,			;RETURN
RESESY:					;SIMPLE SCALAR
	MOVEM	FLAG,(PNT)		;RESTORE VALUE
	POPJ	P,			;RETURN

RESAR2:					;RESTORE ENTIRE ARRAY
	TLNN	FLAG,ISSET		;A SET ARRAY?
	JRST	RESAR3			;NO
	PUSH	P,PNT			;PREPARE TO RECLAIM LIST SPACE
	PUSHJ	P,ARRRCL		;RECLAIM IT
RESAR3:
	TLNN	FLAG,ISSTR		;A STRING ARRAY
	JRST	RESAR4			;NO.
	SUBI	PNT,1
	SUBI	FLAG,1
RESAR4:					;GET READY TO BLT
	HRRZ	B,-1(PNT)		;NUMBER OF WORDS
	ADDI	B,-1(PNT)		;ADDR LAST WORD
	HRLI	PNT,(FLAG)		;BLT WORD
	BLT	PNT,(B)			;DO BLT
	TLNN	FLAG,ISSET		;SET ARRAY?
	POPJ	P,			;NO.
	SAVACS	<(LPSA,D,C)>
	MOVEI	A,(PNT)			;ADDR ARRAY TO BE COPIED
	PUSHJ	P,COPARR		;COPY LISTS WITHIN ARRAY
	RESTACS	<(C,D,LPSA)>		;RESTORE AC'S
	POPJ	P,

DSCR  ALLRM,ALLFOR,ALLRS. 
	REMEMBER ALL IN CONTEXT;
	FORGET ALL IN CONTEXT;
	RESTORE ALL IN CONTEXT;

	CONTEXT ADDR IN -1(P) ⊗

HERE(ALLRM)				;REMEMBER ALL
	PUSHJ	P,STACSV
	MOVE 	TABL,GOGTAB		;USER TABLE
	HRRZ	C,@-1(P)		;FIRST IN CONTEXT LIST
LPALLR:
	JUMPE	C,ENDALL		;PROCESSED EVERYTHING IN CONTEXT?
	PUSHJ	P,REP1			;ALTER THIS NODE.
	HRRZ	C,(C)			;CDR CONTEXT LIST.
	TRZ	C,DESC			;TURN OFF DESC BIT
	JRST	LPALLR			;LOOP
ENDALL:		
	PUSHJ	P,STACRS
	SUB	P,X22			;PREPARE TO RETURN
	JRST	@2(P)			;RETURN



HERE(ALLFOR)				;FORGET ALL
	PUSHJ	P,STACSV
	MOVE	TABL,GOGTAB		;USER TABLE
	MOVEI	B,@-1(P)		;ADDR CONTEXT LIST HEAD
LPALLF:
	SKIPN	C,(B)			;NEXT NODE IN CONTEXT LIST
	JRST	ENDALL			;NONE LEFT.
	PUSHJ	P,RELNOD		;RELEASE THIS NODE
	JRST	LPALLF			;LOOP


HERE(ALLRS)				;RESTORE ALL
	PUSHJ	P,STACSV
	MOVE	TABL,GOGTAB
	MOVE	C,@-1(P)		;FIRST NODE IN CONTEXT LIST
LPRESA:
	JUMPE	C,ENDALL		;NONE LEFT?
	PUSHJ	P,RESNOD		;RESTORE THIS NOD
	HRRZ	C,(C)			;CDR CONTEXT LST
	TRZ	C,DESC
	JRST	LPRESA

DSCR GFREES ⊗
GLOB <
GFREES:				;ATTEMPT TO USE WASTED SPACE IN INFOTAB,DATAB
	PUSHJ	P,FSAV		;SAVE AC'S (PROBABLY NOT NECESSARY)
	MOVE	B,ITMTOP(USER)	;MAX LOCAL ITEM NUMBER
	MOVEI	C,GBRK		;BEGINNING OF GLOBALS
	CAIL	B,-20(C)	;WON'T EVEN TRY IF LESS THAN 20 SPACES
	JRST	FREST		;RESTORE AC'S AND RETURN
	SUBI	C,2(B)		;COUNT OF FREE SPACES
	PUSH	P,C		;SAVE FOR LATER
	ADD	B,INFOTAB(USER) ;
	ADDI	B,1		;ONE MORE
	HRRM	B,FP1(USER)	;BEGINNING OF LIST OF AVAILABLE SPACE
	ADDI	B,1		;GET READY TO LINK UP.
	HRRZM	B,-1(B)		;LINK UP.
	SOJG	C,.-2		;LOOP UNTIL DONE
	SETZM	(B)		;LAST LINK IS NIL.
	HRLM	B,FP1(USER)	;ADDRESS LAST FREE CELL
	POP	P,C		;NUMBER OF FREE CELLS
	LSH	C,-1		;DIVIDE BY 2
	MOVE	B,DATAB(USER)
	ADD	B,ITMTOP(USER)	;ADDRESS FIRST AVAIL TWO-WORD FREE -1.
	ADDI	B,1		;ADDRESS FIRST TWO-WORD FREE
	HRRZM	B,FP2(USER)	;BEGINNING OF LIST OF AVAIL. SPACE
	ADDI	B,2		;LINKING THEM UP.
	HRRZM	B,-2(B)		;LINK.
	SOJG	C,.-2		;LOOP UNTIL DONE
	SETZM	(B)		;LAST LINK IS NIL
	PUSHJ	P,FREST		;RESTORE AC'S
	HRROS  UUO1(USER)	;DON'T NEED MORE FREES
	POPJ	P,
>;GLOB


;GET BOTH KINDS OF FREE STORAGE.
FPEES:	PUSHJ	P,FP2DON	;GO GET FREE STORAGE.

DSCR FP1DON FP2DON
THESE ARE THE ROUTINES FOR GETTING MORE FREE STORAGE FROM
THE MAIN CORE ALLOCATORS.  FP1DON GETS 1 WORD FREES, FP2DON
GETS 2 WORD FREES. THEY ARE GENERALLY CALLED UNDER A SKIPN FP,(FP)
AND RETURN FP POINTING TO THE HEAD OF THE NEW FREE STORAGE LIST.

FP1DON DOES A SPECIAL THING -- THE LAST ELEMENT OF THE OLD FREE
STORAGE LIST IS LINKED TO THE FIRST ELEMENT OF THE NEW ONE -- THIS
IS SO THAT SETS (I.E. LINKED LISTS) CAN BE MADE IN ONE PIECE,
WITHOUT WORRYING ABOUT LINKING THE INDIVIDUAL CELLS TOGETHER.

ACS SAVED -- ALL
AC RESULT -- FP HAS NEW POINTER.
⊗;
HERE(FP1DON)
	PUSHJ	P,FSAV
	LPCOR	(FREELEN,)	;GET THE CORE
	HRRM	B,FP1(TABL)
	HRRZM 	B,SGACS+FP(USER)
	HLRZ	C,FP1(TABL)	;THIS WAS THE LAST WORD BEFORE.
	SKIPE	C		;NONE THERE
	HRRM	B,(C)		;LINK IT DOWN....
	MOVNI	A,FREELEN-1
	ADDI	B,1
	HRRZM	B,-1(B)		;LINK UP THE LIST
	AOJL	A,.-2
	SETZM	(B)
	HRLM	B,FP1(TABL)	;SAVE ADDR OF LAST FREE FOR LINKING
	JRST	FREST		;AND DONE.

HERE(FP2DON)
	PUSHJ	P,FSAV
	LPCOR	(FREELEN,FP2)
	HRRZM 	B,SGACS+FP(USER)
	MOVNI	A,FREELEN/2-1
	ADDI	B,2
	HRRZM	B,-2(B)
	AOJL	A,.-2		;LINK UP.
	SETZM	(B)
;	JRST	FREST
FREST:	MOVSI	14,SGACS(USER)
	BLT	14,14
	POPJ	P,

FSAV:	MOVEM	14,SGACS+14(USER)
	MOVEI	14,SGACS(USER)
	BLT	14,SGACS+13(USER)
	POPJ	P,


DSCR SDESCR - GET A TWO WORD STRING DESCRIPTOR
	A LIST OF TWO WORD STRING DESCRIPTORS (COLLECTABLE BY
	GARBAGE COLLECTOR) IS HEADED IN LEFT-HALF HASHP(USER).
	THIS ROUTINE WILL RETURN CAR OF THIS LIST ON TOP OF 
	STACK AND IF LIST IS NULL WILL ALLOCATE A NEW
	STRING ARRAY, LINK THAT ARRAY INTO THE LIST OF STRING
	ARRAYS (ARYLS(USER)) AND LINK TOGETHER THE INDIVIDUAL
	ARRAY ELEMENTS TO FORM A NEW LIST OF STRING DESCRIPTORS.

	ALL AC'S ARE RESTORED TO THEIR PREVIOUS VALUES BEFORE
	EXIT FROM THE ROUTINE. ⊗

HERE(SDESCR)					;ENTRY-POINT
	ADD	P,[XWD 15,15]		;WILL SAVE AC'S ON STACK
	SKIPL	P			;STACK OVERFLOW?
	PDLOF				;YES.
	PUSH	P,USER			;SAVE USER ALSO.
	HRRI	USER,-15(P)		;ADDR. WHERE 0 TO BE SAVED
	BLT	USER,-1(P)		;SAVE AC'S 0 TO 14
	MOVE	USER,GOGTAB		;USER TABLE
	HLRZ	A,HASHP(USER)		;ANY FREE DESCRIPTORS.
	JUMPN	A,UNLINK		;IF YES, TAKE CAR.
	SKIPE	HASHP(USER)		;PNAMES ALSO
	JRST	NOINIT			;ALREADY INITED.
	MOVEI	C,0			;COUNT OF PNAMES REQUIRED
	MOVE	A,SPLNK(USER)		;SPACE ALLOCATION BLOCK LIST
PNMCNT:	JUMPE	A,HAVCNT		;THROUGH WITH ALLOCATION BLOCKS
	CAMGE	C,$PNMNO(A)		;MORE THAN THIS PROG REQUIRES?
	MOVE	C,$PNMNO(A)		;NO.
	HRRZ	A,(A)			;CDR ALLOCATION LIST
	JRST	PNMCNT			;LOOP
HAVCNT:	CAIG	C,50			;AT LEAST 50?
NOINIT:	MOVEI	C,50			;STANDARD SIZE IS 50
	PUSH	P,[0]			;MAKE THE STRING ARRAY
	PUSH	P,C			;UPPER BOUND
	PUSH	P,[XWD -1,1]		;INDICATE STRING ARRAY
	MOVE	C,UUO1(USER)		;SINCE ARMAK WILL DESTROY
	PUSHJ	P,ARMAK			;MAKE THE ARRAY
	MOVE	USER,GOGTAB
	MOVEM	C,UUO1(USER)		;RESTORE UUO1
	SKIPN	FP,FP1(USER)		;ONE-WORD FREE'S INITED?
	PUSHJ	P,FP1DON		;NO.
	MOVEI	B,(FP)			;ADDR. ONE-WORD FREE
	SKIPN	FP,(FP)			;FOR NEXT TIME
	PUSHJ	P,FP1DON		;IF OUT, GET MORE.
	HRRM	FP,FP1(USER)		;SAVE FREE-LIST
	HRLI	D,(A)			;ADDRESS NEW STRING ARRAY
	HRR	D,ARYLS(USER)		;LINK IN OLD ARRAY LIST
	MOVEM	D,(B)			;INTO ONE-WORD FREE
	HRRM	B,ARYLS(USER)		;NEW STRING ARRAY LIST.
	MOVN	C,-4(A)			;LENGTH OF ARRAY
	HRL	A,A			;
	ADDI	A,2
INT2:	HLRM	A,(A)			;LINK THEM UP
	ADD	A,X22
	AOJL	C,INT2			;LOOP.
	HLR	A,A			;FREE STRING DESCRIPTOR LIST
UNLINK:					;HEAD OF DESCRIPTOR LIST IN A
	HRRZ	B,(A)			;CDR DESCRIPTOR LIST
	HRLM	B,HASHP(USER)		;SAVE CDR
	SETZM	-1(A)			;MAKE INTO NIL STRING
	EXCH	A,-16(P)		;EXCHANGE WITH RETURN ADDR
	PUSH	P,A			;SAVE RETURN ADDR.
	HRLZI	USER,-16(P)		;ADDR WHERE AC 0 SAVED
	BLT	USER,USER		;RESTORE AC'S
	SUB	P,[XWD 17,17]		;RESTORE STACK
	JRST	@17(P)			;RETURN
DSCR .INCONT- IS VAR IN CONTEXT
⊗
HERE(.INCONT)
	PUSHJ	P,STACSV	;SAVE THE AC'S
	MOVE	USER,GOGTAB	;SET UP USER TABLE
	POP	P,UUO1(USER)	;SAVE RETURN ADDRESS
	POP	P,LPSA		;THE CONTEXT POINTER
	JUMPE	LPSA,NFALRET	;NOTHING IN NULL CONTEXT
	MOVE	PNT,(P)		;THE THING WE'RE LOOKING FOR
	SETZM	TEMP		;FIRST TIME THROUGH
NCNLP:	HLRZ	B,(LPSA)	;CONTEXT ELEMENT ADDR
	CAIL	B,(PNT)		;KEEP ON SEARCHING?
	JRST	CHKAD2		;NO.
	MOVEI	TEMP,(LPSA)	;SAVE POINTER TO PREVIOUS ELEMENT
	HRRZ	LPSA,(LPSA)	;CDR CONTEXT LIST
	TRZ	LPSA,DESC
	JUMPN	LPSA,NCNLP	;LOOP IF NOT THROUGH

CHKAD1:				;CHECK TO SEE IF PREDECESSOR AN ARRAY
	JUMPE	TEMP,NFALRET	;NO PREDECESSOR
	TLNE	PNT,ISARR	;IF AN ARRAY NO HOPE
	JRST	NFALRET		;
	MOVE	B,(TEMP)	;IS PREDECESSOR AN ARRAY
	MOVE	C,1(TEMP)	;
	TRNE	B,DESC
	TLNN	C,ISARR
	JRST	NFALRET		;NOT AN ARRAY
	HLRZ	B,B		;ARRAY DESCRIPTOR ADDRESS
	HRRZ	C,-1(B)		;SIZE OF ARRAY
	SKIPG	-2(B)		;A STRING ARRAY?
	HRRZ	C,-2(B)
	ADDI	B,(C)		;ONE POS PAST ADDR LAST IN ARRAY
	CAMLE	B,(PNT)
	JRST	NTRURET
NFALRET: TDZA	A,A
NTRURET: SETOM	A
	MOVEM	A,STACS+1(USER)	;THE RETURN VALUE
	MOVE	PNT,UUO1(USER)	;THE RETURN ADDRESS
	EXCH	PNT,(P)
	JRST	STACRS

CHKAD2:	CAIE	B,(PNT)		;THE SAME
	JRST	CHKAD2		;NO CHECK PREDECESSOR
	MOVE	B,(LPSA)
	MOVE	C,1(LPSA)	;SEE IF THIS AN ARRAY
	TRNE	B,DESC
	TLNN	C,ISARR
	SKIPA
	JRST	NTRURET		;YES AN ARRAY
	MOVE	PNT,(P)
	TLNE	PNT,ISARR
	JRST	NFALRET
	JRST	NTRURET

BEND	LEAP
	XLIST		;EXPURGATE SYMBOLS


IFN SEGS,<LIT
	VAR
	DEPHASE 
	END	UPWRT>
	END